# Utilities for defining Protocols and Actions
# 
###############################################################################
#' Turn a protocol application into an action. 
#' 
#' turn a protocol application into an action. Thus creating a specialized action with the protocol applications 
#' parameters completely or partially fixed. Additionally reduce I/O overhead by more w/o intermediate I/O.
#' currently not implemented !!!
#' @param protocolApplication The protocolApplication that should be turned into an action.
actionFromProtocolApplication <- function(protocolApplication)
{
    
}

#' Combine lists of output files generated during pipeline execution into a data.frame specifying data locations for a 
#' protocolApplication
#' 
#' @param outputFileListNames list of character strings giving the names of the list of output files to combine
dataLocationFromOutputFileList <- function(outputFileListNames)
{
    outputFileLists <- list()
    for (name in outputFileListNames)
        outputFileLists[[name]] <- readCsvFile(name)
    
    listLengths <- sapply(outputFileLists,nrow)
    if ( length(unique(listLengths)) != 1 )
        submitToLog(paste("Output file list passed to ",sys.call()[[1]],"have unequal length"),"Error")
    
    dataLocation <- outputFileLists[[1]]
    for (fileList in outputFileLists[-1])
        dataLocation <- cbind(dataLocation,fileList)
    dataLocation
}

#' Combine lists of output files generated during pipeline execution into a file specifying data locations for a 
#' protocolApplication
#' 
#' @param outputFileListNames list of character strings giving the names of the list of output files to combine
#' @param fileName character string giving the name of the dataLocation file to be created
dataLocationFileFromOutputFileList <- function(outputFileListNames,fileName)
{
    dataLocation <- dataLocationFromOutputFileList(outputFileListNames)
    
    writeCsvFile(file=fileName, data=dataLocation)  
}

#' Generate a list of input data sets.
#'
#' A list of input data for a protocol application is generated from a data frame. Each row of the data frame
#' is interpreted as one set of data to be made available simultaneously to an action.
#' @param data An object that can be coerced to a data frame
#' @export 
fileListFromDataframe <-function(data)
{
    fileList <- list()
    # TODO: vectorize
    for (i in 1:nrow(data))
    {
        fileList[[i]] <- as.list(data[i,])
        for (j in 1:length(fileList[[i]] ) )
                    attr(fileList[[i]][[j]],which="Type") <- colnames(data)[j]     
    }
    fileList     
}


#' Add a protocol application as a child protocol application to an existing pipeline
#' 
#' A protocol application is added to an existing pipeline, as the next step after the protocolApplication specified in
#' the first argument, optionally using the output of the previous step as one of its inputs. 
#' If protocolApplication is not a protocolList and has no parent protocolList, the parent is created automatically.   
#' @param protocolApplication The parent ProtocolApplication
#' @param childProtocolApplication the child ProtocolApplication that's beeing added.
#' @param replaceInput boolean flag determining if the childs input data shall be replaced by it's parents. 
addChildProtocolApplication<- function(protocolApplication, childProtocolApplication, replaceInput=TRUE)
{
    # Is there a parent ProtocolApplication (whose action thus is protocolList) we can add the child to?
    parentProtocolApplication <- protocolApplication@.parent
    if (is.null(parentProtocolApplication) )
    {
        parentName <- paste(protocolApplication@name, childProtocolApplication@name, sep="_")       
        parentProtocolApplication <- buildProtocolApplication(parameterValues=list(), 
                                                              dataLocation=as.null(), 
                                                              action=protocolList,
                                                              name= parentName)
        parentProtocolApplication@.childProtocolApplications <- list(protocolApplication)
    }
    # change the input of the added protocolApplication
    if (replaceInput)
    {
        childProtocolApplication@.dataLocationFile <- getListFileName(protocolApplication)    
    }
    # add the protcolApplication to the list of children
    childProtocolApplicationList <- parentProtocolApplication@.childProtocolApplications
    insert(childProtocolApplicationList, item=childProtocolApplication, after=protocolApplication)
    parentProtocolApplication@.childProtocolApplications <- childProtocolApplicationList

    return(parentProtocolApplication)
}

#' Insert an item into a list
#' 
#' Inserts the item after the position of after. If item is not specified nothing will be inserted.
#' @param x the list into which item will be inserted
#' @param item an R object to be inserted into the list x
#' @param after the R object after which the item should be inserted, if there are multiple objects the new item will be inserted after the first occurrence of the object 
#' @return The list with the inserted item.
insert <- function(x,item=as.null(),after=NULL) 
{
    if (!is.list(x))
        stop("x must be a list")
    if (length(x)==0)
        returnList <- item
    else if (is.null(after))
        returnList <- c(x,item)
    else
    { 
        position <- 1
        while( x[[position]]!=after)
        {     
            position <- position+1
            if (position > length(x))
                stop(paste("No occurrence of",item,"found"))
        }
        returnList <- x[1:position]
        returnList[[position+1]] <- item
        if ( (position+1)<= length(x) )
            returnList <- c(returnList,x[(position+1):length(x)])
    }
    return(returnList)
}

#' Extract the value of a logical parameter from a list of parameters. 
#' 
#' The value defaults to FALSE if the parameter is absent or can not be interpreted as logical.
#' @param parameter a named list that stores parameters
#' @param name the name of the logical parameter that will be extracted from the list.  
#' @export 
getLogicalParameter <- function(parameter,name)
{
    if (is.null(parameter[[name]]))
        parameter[[name]] <- FALSE
    result <- as.logical(parameter[[name]])
    if (is.na(result)) 
        result <- FALSE
    return(result)
}
